home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / predef.ada < prev    next >
Encoding:
Text File  |  1992-02-07  |  24.4 KB  |  750 lines
  1. -- 
  2. -- 
  3. --               ********************************** 
  4. --               *                                *  
  5. --               *           T  e  x  t           * 
  6. --               *                                *  
  7. --               *     Input / Output  Package    * 
  8. --         *                  *
  9. --         *         and other          *
  10. --         *                  *
  11. --         *        Predefined Units      *
  12. --               *                                *  
  13. --               *                                *  
  14. --         *         ADA Project      *
  15. --         *      Courant Institute      *
  16. --         *     New York University      *
  17. --         *      251 Mercer Street,      *
  18. --         *      New York, NY 10012      *
  19. --               *                                *  
  20. --               ********************************** 
  21. -- 
  22. -- 
  23. --
  24. pragma page;
  25. --  This file contains several of the predefined Ada package spec-
  26. --  ifications.  They do not actually implement the package's
  27. --  operations, which are coded in the implementation language C,
  28. --  but they provide an interface to them through the standard 
  29. --  procedure/function calling mechanism. The predefined packages are:
  30. --
  31. --      . The SYSTEM package.
  32. --
  33. --      . The IO_EXCEPTIONS package.
  34. --
  35. --      . The generic SEQUENTIAL_IO package.
  36. --
  37. --      . The generic DIRECT_IO package.
  38. -- 
  39. --      . The TEXT_IO package.  
  40. --
  41. --    . The CALENDAR package and the predefined subprograms 
  42. --      UNCHECKED_CONVERSION and UNCHECKED_DEALLOCATION.
  43. --
  44. --
  45. pragma page;
  46.  
  47. package SYSTEM is
  48.  
  49.    type NAME    is (ELXSI_BSD, ELXSI_ENIX, PC_DOS, 
  50.              SUN_UNIX, VAX_UNIX, VAX_VMS) ; 
  51.  
  52.    SYSTEM_NAME  : constant NAME := SUN_UNIX;
  53.    STORAGE_UNIT : constant      := 32;
  54.    MEMORY_SIZE  : constant      := 2**16 - 1;
  55.  
  56.    -- System Dependent Named Numbers:
  57.  
  58.    MIN_INT      : constant      := -2**31;
  59.    MAX_INT      : constant      :=  2**31-1;
  60.    MAX_DIGITS   : constant      := 6;
  61.    MAX_MANTISSA : constant      := 31;
  62.    FINE_DELTA   : constant      := 2.0**(-30);
  63.    TICK         : constant      := 0.01;
  64.  
  65.    -- Other System Dependent Declarations
  66.  
  67.    subtype PRIORITY is INTEGER range 1 .. 4;
  68.  
  69.    type SEGMENT_TYPE is new INTEGER range 0..255;
  70.    type OFFSET_TYPE  is new INTEGER range 0..32767;
  71.    type ADDRESS is record
  72.         SEGMENT : SEGMENT_TYPE := SEGMENT_TYPE'LAST;
  73.         OFFSET  : OFFSET_TYPE  := OFFSET_TYPE'LAST;
  74.    end record;
  75.  
  76.    SYSTEM_ERROR : exception;
  77.  
  78. end SYSTEM;
  79.  
  80. package IO_EXCEPTIONS is
  81.  
  82.    STATUS_ERROR : exception;
  83.    MODE_ERROR   : exception;
  84.    NAME_ERROR   : exception;
  85.    USE_ERROR    : exception;
  86.    DEVICE_ERROR : exception;
  87.    END_ERROR    : exception;
  88.    DATA_ERROR   : exception;
  89.    LAYOUT_ERROR : exception;
  90.  
  91. end IO_EXCEPTIONS;
  92.  
  93. pragma page;
  94. with IO_EXCEPTIONS;
  95. generic
  96.     type ELEMENT_TYPE is private;
  97.  
  98. package SEQUENTIAL_IO is
  99.  
  100.     type FILE_TYPE is limited private;
  101.     
  102.     type FILE_MODE is (IN_FILE, OUT_FILE);
  103.       
  104.  
  105.     -- File management
  106.  
  107.  
  108.     procedure CREATE   (FILE : in out FILE_TYPE;
  109.                         MODE : in FILE_MODE := OUT_FILE;
  110.                         NAME : in STRING    := "";
  111.                         FORM : in STRING    := "");
  112.     pragma IO_interface(CREATE,SIO_CREATE,ELEMENT_TYPE);
  113.  
  114.     procedure OPEN     (FILE : in out FILE_TYPE;
  115.                         MODE : in FILE_MODE;
  116.                         NAME : in STRING;
  117.                         FORM : in STRING := "");
  118.     pragma IO_interface(OPEN,SIO_OPEN,ELEMENT_TYPE);
  119.  
  120.     procedure CLOSE    (FILE : in out FILE_TYPE);
  121.     pragma IO_interface(CLOSE,SIO_CLOSE);
  122.  
  123.     procedure DELETE   (FILE : in out FILE_TYPE);
  124.     pragma IO_interface(DELETE,SIO_DELETE);
  125.  
  126.     procedure RESET    (FILE : in out FILE_TYPE; MODE : in  FILE_MODE);
  127.     pragma IO_interface(RESET,SIO_RESET_MODE,ELEMENT_TYPE);
  128.     procedure RESET    (FILE : in out FILE_TYPE);
  129.     pragma IO_interface(RESET,SIO_RESET,ELEMENT_TYPE);
  130.  
  131.     function  MODE     (FILE : in FILE_TYPE)  return FILE_MODE;
  132.     pragma IO_interface(MODE,SIO_MODE);
  133.  
  134.     function  NAME     (FILE : in FILE_TYPE)  return STRING;
  135.     pragma IO_interface(NAME,SIO_NAME);
  136.  
  137.     function  FORM     (FILE : in FILE_TYPE)  return STRING;
  138.     pragma IO_interface(FORM,SIO_FORM);
  139.     
  140.     function  IS_OPEN  (FILE : in FILE_TYPE)  return BOOLEAN;
  141.     pragma IO_interface(IS_OPEN,SIO_IS_OPEN);
  142.  
  143.     -- Input and Output Operations:
  144.  
  145.     procedure READ   (FILE : in FILE_TYPE; ITEM : out ELEMENT_TYPE);
  146.     pragma IO_interface(READ,SIO_READ,ELEMENT_TYPE);
  147.  
  148.     procedure WRITE  (FILE : in FILE_TYPE; ITEM : in ELEMENT_TYPE);
  149.     pragma IO_interface(WRITE,SIO_WRITE,ELEMENT_TYPE);
  150.  
  151.     function  END_OF_FILE(FILE : in FILE_TYPE) return BOOLEAN;
  152.     pragma IO_interface(END_OF_FILE,SIO_END_OF_FILE);
  153.  
  154.     -- Exceptions:
  155.  
  156.     STATUS_ERROR : exception renames IO_EXCEPTIONS.STATUS_ERROR;
  157.     MODE_ERROR   : exception renames IO_EXCEPTIONS.MODE_ERROR;
  158.     NAME_ERROR     : exception renames IO_EXCEPTIONS.NAME_ERROR;
  159.     USE_ERROR     : exception renames IO_EXCEPTIONS.USE_ERROR;
  160.     DEVICE_ERROR : exception renames IO_EXCEPTIONS.DEVICE_ERROR;
  161.     END_ERROR     : exception renames IO_EXCEPTIONS.END_ERROR;
  162.     DATA_ERROR     : exception renames IO_EXCEPTIONS.DATA_ERROR;
  163.  
  164. private
  165.  
  166.     UNINITIALIZED: constant := 0;
  167.     type FILE_TYPE is record
  168.                          FILENUM: INTEGER := UNINITIALIZED; 
  169.                       end record;
  170.  
  171. end SEQUENTIAL_IO;
  172.  
  173. package body SEQUENTIAL_IO is
  174. end SEQUENTIAL_IO;
  175.  
  176. pragma page;
  177. with IO_EXCEPTIONS;
  178. generic
  179.     type ELEMENT_TYPE is private;
  180.  
  181. package DIRECT_IO is
  182.  
  183.     type  FILE_TYPE  is limited private;
  184.  
  185.     type    FILE_MODE       is (IN_FILE, INOUT_FILE, OUT_FILE);
  186.     type    COUNT           is range 0 .. INTEGER'LAST;
  187.     subtype POSITIVE_COUNT  is COUNT range 1 .. COUNT'LAST;    
  188.       
  189.  
  190.     -- File management
  191.  
  192.  
  193.     procedure CREATE   (FILE : in out FILE_TYPE;
  194.                         MODE : in FILE_MODE := INOUT_FILE;
  195.                         NAME : in STRING := "";
  196.                         FORM : in STRING := "");
  197.     pragma IO_interface(CREATE,DIO_CREATE,ELEMENT_TYPE);
  198.  
  199.     procedure OPEN     (FILE : in out FILE_TYPE;
  200.                         MODE : in FILE_MODE;
  201.                         NAME : in STRING;
  202.                         FORM : in STRING := "");
  203.     pragma IO_interface(OPEN,DIO_OPEN,ELEMENT_TYPE);
  204.  
  205.     procedure CLOSE    (FILE : in out FILE_TYPE);
  206.     pragma IO_interface(CLOSE,DIO_CLOSE);
  207.  
  208.     procedure DELETE   (FILE : in out FILE_TYPE);
  209.     pragma IO_interface(DELETE,DIO_DELETE);
  210.  
  211.     procedure RESET    (FILE : in out FILE_TYPE; MODE : in  FILE_MODE);
  212.     pragma IO_interface(RESET,DIO_RESET_MODE,ELEMENT_TYPE);
  213.     procedure RESET    (FILE : in out FILE_TYPE);
  214.     pragma IO_interface(RESET,DIO_RESET,ELEMENT_TYPE);
  215.  
  216.     function  MODE     (FILE : in FILE_TYPE)  return FILE_MODE;
  217.     pragma IO_interface(MODE,DIO_MODE);
  218.  
  219.     function  NAME     (FILE : in FILE_TYPE)  return STRING;
  220.     pragma IO_interface(NAME,DIO_NAME);
  221.  
  222.     function  FORM     (FILE : in FILE_TYPE)  return STRING;
  223.     pragma IO_interface(FORM,DIO_FORM);
  224.     
  225.     function  IS_OPEN  (FILE : in FILE_TYPE)  return BOOLEAN;
  226.     pragma IO_interface(IS_OPEN,DIO_IS_OPEN);
  227.  
  228.     -- Input and Output Operations:
  229.  
  230.     procedure READ   (FILE : in FILE_TYPE; ITEM : out ELEMENT_TYPE);
  231.     pragma IO_interface(READ,DIO_READ,ELEMENT_TYPE);
  232.     procedure READ   (FILE : in FILE_TYPE; ITEM : out ELEMENT_TYPE;
  233.                                            FROM : in POSITIVE_COUNT);
  234.     pragma IO_interface(READ,DIO_READ_FROM,ELEMENT_TYPE);
  235.  
  236.     procedure WRITE  (FILE : in FILE_TYPE;  ITEM : in ELEMENT_TYPE);
  237.     pragma IO_interface(WRITE,DIO_WRITE,ELEMENT_TYPE);
  238.     procedure WRITE  (FILE : in FILE_TYPE;  ITEM : in ELEMENT_TYPE;
  239.                                             TO   : in POSITIVE_COUNT);
  240.     pragma IO_interface(WRITE,DIO_WRITE_TO,ELEMENT_TYPE);
  241.  
  242.     procedure SET_INDEX(FILE : in FILE_TYPE; TO :in POSITIVE_COUNT);
  243.     pragma IO_interface(SET_INDEX,DIO_SET_INDEX);
  244.    
  245.     function  INDEX    (FILE : in FILE_TYPE)  return POSITIVE_COUNT;
  246.     pragma IO_interface(INDEX,DIO_INDEX);
  247.  
  248.     function  SIZE     (FILE : in FILE_TYPE)  return COUNT;
  249.     pragma IO_interface(SIZE,DIO_SIZE);
  250.       
  251.     function  END_OF_FILE(FILE : in FILE_TYPE) return BOOLEAN;
  252.     pragma IO_interface(END_OF_FILE,DIO_END_OF_FILE);
  253.  
  254.     -- Exceptions:
  255.  
  256.     STATUS_ERROR : exception renames IO_EXCEPTIONS.STATUS_ERROR;
  257.     MODE_ERROR   : exception renames IO_EXCEPTIONS.MODE_ERROR;
  258.     NAME_ERROR     : exception renames IO_EXCEPTIONS.NAME_ERROR;
  259.     USE_ERROR     : exception renames IO_EXCEPTIONS.USE_ERROR;
  260.     DEVICE_ERROR : exception renames IO_EXCEPTIONS.DEVICE_ERROR;
  261.     END_ERROR     : exception renames IO_EXCEPTIONS.END_ERROR;
  262.     DATA_ERROR     : exception renames IO_EXCEPTIONS.DATA_ERROR;
  263.  
  264. private
  265.  
  266.     UNINITIALIZED: constant := 0;
  267.     type FILE_TYPE is record
  268.                          FILENUM: INTEGER := UNINITIALIZED; 
  269.                       end record;
  270.  
  271. end DIRECT_IO;
  272.  
  273. package body DIRECT_IO is
  274. end DIRECT_IO;
  275.  
  276. pragma page;
  277. with IO_EXCEPTIONS;
  278. package TEXT_IO is 
  279.      
  280.   type FILE_TYPE  is limited private;
  281.  
  282.   type FILE_MODE  is (IN_FILE, OUT_FILE);
  283.  
  284.   type COUNT is range 0 .. 32767;
  285.  
  286.   subtype POSITIVE_COUNT IS COUNT range 1 .. COUNT'LAST;
  287.  
  288.   UNBOUNDED : constant COUNT := 0; -- line and page length
  289.  
  290.   subtype FIELD is INTEGER range 0 .. 100 ;
  291.   subtype NUMBER_BASE is INTEGER range 2 .. 16;
  292.  
  293.   type TYPE_SET is (LOWER_CASE, UPPER_CASE);
  294.  
  295.   -- File Management
  296.  
  297.      
  298.   procedure CREATE (FILE : in out FILE_TYPE;
  299.                     MODE : in FILE_MODE := OUT_FILE;
  300.                     NAME : in STRING    := "";
  301.                     FORM : in STRING    := "");
  302.   pragma IO_interface(CREATE,TIO_CREATE);
  303.     
  304.   procedure OPEN   (FILE : in out FILE_TYPE;
  305.                     MODE : in FILE_MODE;
  306.                     NAME : in STRING;
  307.                     FORM : in STRING := "");
  308.   pragma IO_interface(OPEN,TIO_OPEN);
  309.  
  310.   procedure CLOSE  (FILE : in out FILE_TYPE);
  311.   pragma IO_interface(CLOSE,TIO_CLOSE);
  312.     
  313.   procedure DELETE (FILE : in out FILE_TYPE);
  314.   pragma IO_interface(DELETE,TIO_DELETE);
  315.  
  316.   procedure RESET  (FILE : in out FILE_TYPE; MODE : in FILE_MODE);
  317.   pragma IO_interface(RESET,TIO_RESET_MODE);
  318.   procedure RESET  (FILE : in out FILE_TYPE);
  319.   pragma IO_interface(RESET,TIO_RESET);
  320.  
  321.   function MODE (FILE : in FILE_TYPE)     return FILE_MODE;
  322.   pragma IO_interface(MODE,TIO_MODE);
  323.  
  324.   function NAME (FILE : in FILE_TYPE)     return STRING;
  325.   pragma IO_interface(NAME,TIO_NAME);
  326.  
  327.   function FORM (FILE : in FILE_TYPE)     return STRING;      
  328.   pragma IO_interface(FORM,TIO_FORM);
  329.  
  330.   function IS_OPEN (FILE : in FILE_TYPE)  return BOOLEAN;
  331.   pragma IO_interface(IS_OPEN,TIO_IS_OPEN);
  332.  
  333.   -- Control of default input and output files
  334.      
  335.   procedure SET_INPUT  (FILE : in FILE_TYPE);
  336.   pragma IO_interface(SET_INPUT,SET_INPUT);
  337.   procedure SET_OUTPUT (FILE : in FILE_TYPE);
  338.   pragma IO_interface(SET_OUTPUT,SET_OUTPUT);
  339.  
  340.   function STANDARD_INPUT  return FILE_TYPE;
  341.   pragma IO_interface(STANDARD_INPUT,STANDARD_INPUT);
  342.   function STANDARD_OUTPUT return FILE_TYPE;
  343.   pragma IO_interface(STANDARD_OUTPUT,STANDARD_OUTPUT);
  344.  
  345.   function CURRENT_INPUT  return FILE_TYPE;
  346.   pragma IO_interface(CURRENT_INPUT,CURRENT_INPUT);
  347.   function CURRENT_OUTPUT return FILE_TYPE;
  348.   pragma IO_interface(CURRENT_OUTPUT,CURRENT_OUTPUT);
  349.  
  350.   -- Specification of line and page lengths
  351.  
  352.   procedure SET_LINE_LENGTH (FILE : in FILE_TYPE;  TO : in COUNT);
  353.   pragma IO_interface(SET_LINE_LENGTH,SET_LINE_LENGTH_FILE);
  354.   procedure SET_LINE_LENGTH (TO : in COUNT);    -- default output file
  355.   pragma IO_interface(SET_LINE_LENGTH,SET_LINE_LENGTH);
  356.  
  357.   procedure SET_PAGE_LENGTH (FILE : in FILE_TYPE;  TO : in COUNT);
  358.   pragma IO_interface(SET_PAGE_LENGTH,SET_PAGE_LENGTH_FILE);
  359.   procedure SET_PAGE_LENGTH (TO : in COUNT);    -- default output file
  360.   pragma IO_interface(SET_PAGE_LENGTH,SET_PAGE_LENGTH);
  361.  
  362.   function LINE_LENGTH (FILE : in FILE_TYPE)  return COUNT;
  363.   pragma IO_interface(LINE_LENGTH,LINE_LENGTH_FILE);
  364.   function LINE_LENGTH return COUNT;  -- default output file
  365.   pragma IO_interface(LINE_LENGTH,LINE_LENGTH);
  366.      
  367.   
  368.   function PAGE_LENGTH (FILE : in FILE_TYPE)  return COUNT;
  369.   pragma IO_interface(PAGE_LENGTH,PAGE_LENGTH_FILE);
  370.   function PAGE_LENGTH return COUNT; -- default output file
  371.   pragma IO_interface(PAGE_LENGTH,PAGE_LENGTH);
  372.  
  373.   -- Column, Line and Page Control
  374.  
  375.   procedure NEW_LINE (FILE : in FILE_TYPE;  SPACING : in POSITIVE_COUNT := 1);
  376.   pragma IO_interface(NEW_LINE,NEW_LINE_FILE);
  377.   procedure NEW_LINE (SPACING : in POSITIVE_COUNT := 1); 
  378.   pragma IO_interface(NEW_LINE,NEW_LINE);
  379.  
  380.   procedure SKIP_LINE (FILE : in FILE_TYPE;  SPACING : in POSITIVE_COUNT := 1);
  381.   pragma IO_interface(SKIP_LINE,SKIP_LINE_FILE);
  382.   procedure SKIP_LINE (SPACING : in POSITIVE_COUNT := 1);
  383.   pragma IO_interface(SKIP_LINE,SKIP_LINE);
  384.  
  385.   function END_OF_LINE (FILE : in FILE_TYPE) return BOOLEAN;
  386.   pragma IO_interface(END_OF_LINE,END_OF_LINE_FILE);
  387.   function END_OF_LINE return BOOLEAN; -- default input file
  388.   pragma IO_interface(END_OF_LINE,END_OF_LINE);
  389.  
  390.   procedure NEW_PAGE (FILE : in FILE_TYPE);
  391.   pragma IO_interface(NEW_PAGE,NEW_PAGE_FILE);
  392.   procedure NEW_PAGE; -- default output file
  393.   pragma IO_interface(NEW_PAGE,NEW_PAGE);
  394.  
  395.   procedure SKIP_PAGE (FILE : in FILE_TYPE);
  396.   pragma IO_interface(SKIP_PAGE,SKIP_PAGE_FILE);
  397.   procedure SKIP_PAGE; -- default input file
  398.   pragma IO_interface(SKIP_PAGE,SKIP_PAGE);
  399.  
  400.   function END_OF_PAGE (FILE : in FILE_TYPE) return BOOLEAN;
  401.   pragma IO_interface(END_OF_PAGE,END_OF_PAGE_FILE);
  402.   function END_OF_PAGE return BOOLEAN;      
  403.   pragma IO_interface(END_OF_PAGE,END_OF_PAGE);
  404.  
  405.   function END_OF_FILE (FILE : in FILE_TYPE) return BOOLEAN;
  406.   pragma IO_interface(END_OF_FILE,TIO_END_OF_FILE_FILE);
  407.   function END_OF_FILE return BOOLEAN;      
  408.   pragma IO_interface(END_OF_FILE,TIO_END_OF_FILE);
  409.  
  410.   procedure SET_COL(FILE : in FILE_TYPE; TO : in POSITIVE_COUNT);
  411.   pragma IO_interface(SET_COL,SET_COL_FILE);
  412.   procedure SET_COL(TO : in POSITIVE_COUNT); -- default output file
  413.   pragma IO_interface(SET_COL,SET_COL);
  414.  
  415.   procedure SET_LINE(FILE : in FILE_TYPE; TO : in POSITIVE_COUNT);
  416.   pragma IO_interface(SET_LINE,SET_LINE_FILE);
  417.   procedure SET_LINE(TO : in POSITIVE_COUNT); -- default output file
  418.   pragma IO_interface(SET_LINE,SET_LINE);
  419.   
  420.   function COL(FILE : in FILE_TYPE) return POSITIVE_COUNT;
  421.   pragma IO_interface(COL,COL_FILE);
  422.   function COL return POSITIVE_COUNT; -- default output file
  423.   pragma IO_interface(COL,COL);
  424.  
  425.   function LINE(FILE : in FILE_TYPE) return POSITIVE_COUNT;
  426.   pragma IO_interface(LINE,LINE_FILE);
  427.   function LINE return POSITIVE_COUNT; -- default output file
  428.   pragma IO_interface(LINE,LINE);
  429.  
  430.   function PAGE(FILE : in FILE_TYPE) return POSITIVE_COUNT;
  431.   pragma IO_interface(PAGE,PAGE_FILE);
  432.   function PAGE return POSITIVE_COUNT; -- default output file
  433.   pragma IO_interface(PAGE,PAGE);
  434.  
  435.  
  436.   -- Character Input-Output
  437.  
  438.   procedure GET (FILE : in  FILE_TYPE;  ITEM : out CHARACTER);
  439.   pragma IO_interface(GET,GET_CHAR_FILE_ITEM);
  440.   procedure GET (ITEM : out CHARACTER);
  441.   pragma IO_interface(GET,GET_CHAR_ITEM);
  442.   procedure PUT (FILE : in  FILE_TYPE;  ITEM : in CHARACTER);
  443.   pragma IO_interface(PUT,PUT_CHAR_FILE_ITEM);
  444.   procedure PUT (ITEM : in  CHARACTER);
  445.   pragma IO_interface(PUT,PUT_CHAR_ITEM);
  446.  
  447.     
  448.   -- String Input-Output
  449.     
  450.   procedure GET (FILE : in  FILE_TYPE;  ITEM : out STRING);
  451.   pragma IO_interface(GET,GET_STRING_FILE_ITEM);
  452.   procedure GET (ITEM : out STRING);    
  453.   pragma IO_interface(GET,GET_STRING_ITEM);
  454.   procedure PUT (FILE : in  FILE_TYPE;  ITEM : in STRING);
  455.   pragma IO_interface(PUT,PUT_STRING_FILE_ITEM);
  456.   procedure PUT (ITEM : in  STRING);
  457.   pragma IO_interface(PUT,PUT_STRING_ITEM);
  458.  
  459.   procedure GET_LINE (FILE : in FILE_TYPE; ITEM : out STRING;
  460.                                            LAST : out NATURAL);
  461.   pragma IO_interface(GET_LINE,GET_LINE_FILE);
  462.   procedure GET_LINE (ITEM : out  STRING; LAST : out NATURAL);
  463.   pragma IO_interface(GET_LINE,GET_LINE);
  464.  
  465.   procedure PUT_LINE (FILE : in FILE_TYPE; ITEM : in STRING);
  466.   pragma IO_interface(PUT_LINE,PUT_LINE_FILE);
  467.   procedure PUT_LINE (ITEM : in STRING);
  468.   pragma IO_interface(PUT_LINE,PUT_LINE);
  469.     
  470.   -- Generic package for Input-Output of Integer Types
  471.  
  472.   generic
  473.     type NUM is range <>;
  474.   package INTEGER_IO is
  475.  
  476.     DEFAULT_WIDTH : FIELD := NUM'WIDTH;
  477.     DEFAULT_BASE  : NUMBER_BASE := 10;
  478.  
  479.     procedure GET (FILE  : in FILE_TYPE;  ITEM : out NUM; 
  480.                                           WIDTH : in FIELD := 0);
  481.     pragma IO_interface(GET,GET_INTEGER_FILE_ITEM,NUM);
  482.  
  483.     procedure GET (ITEM  : out NUM; WIDTH : in FIELD := 0);
  484.     pragma IO_interface(GET,GET_INTEGER_ITEM,NUM);
  485.  
  486.     procedure PUT (FILE  : in FILE_TYPE;
  487.                ITEM  : in NUM;
  488.                WIDTH : in FIELD := DEFAULT_WIDTH;
  489.                BASE  : in NUMBER_BASE := DEFAULT_BASE);
  490.     pragma IO_interface(PUT,PUT_INTEGER_FILE_ITEM,NUM);
  491.     procedure PUT (ITEM  : in NUM;
  492.                WIDTH : in FIELD := DEFAULT_WIDTH;
  493.                BASE  : in NUMBER_BASE := DEFAULT_BASE);
  494.     pragma IO_interface(PUT,PUT_INTEGER_ITEM,NUM);
  495.     
  496.     procedure GET (FROM : in STRING; ITEM: out NUM; LAST: out POSITIVE);
  497.     pragma IO_interface(GET,GET_INTEGER_STRING,NUM);
  498.     procedure PUT (TO   : out STRING;
  499.                    ITEM : in  NUM;
  500.                    BASE : in  NUMBER_BASE := DEFAULT_BASE);
  501.     pragma IO_interface(PUT,PUT_INTEGER_STRING,NUM);
  502.  
  503.   end INTEGER_IO;
  504.  
  505.  
  506.   -- Generic packages for Input-Output of Real Types
  507.  
  508.   generic
  509.     type NUM is digits <>;
  510.   package FLOAT_IO is
  511.  
  512.     DEFAULT_FORE : FIELD := 2;
  513.     DEFAULT_AFT  : FIELD := NUM'DIGITS-1;
  514.     DEFAULT_EXP  : FIELD := 3;
  515.  
  516.     procedure GET (FILE : in FILE_TYPE; ITEM : out NUM;
  517.                                         WIDTH : in FIELD := 0);
  518.     pragma IO_interface(GET,GET_FLOAT_FILE_ITEM,NUM);
  519.     procedure GET (ITEM : out NUM; WIDTH : in FIELD := 0);
  520.     pragma IO_interface(GET,GET_FLOAT_ITEM,NUM);
  521.  
  522.     procedure PUT (FILE        : in FILE_TYPE;
  523.            ITEM        : in NUM;
  524.            FORE            : in FIELD := DEFAULT_FORE;
  525.            AFT      : in FIELD := DEFAULT_AFT;
  526.            EXP       : in FIELD := DEFAULT_EXP);
  527.     pragma IO_interface(PUT,PUT_FLOAT_FILE_ITEM,NUM);
  528.  
  529.     procedure PUT (ITEM        : in NUM;
  530.            FORE       : in FIELD := DEFAULT_FORE;
  531.            AFT      : in FIELD := DEFAULT_AFT;
  532.            EXP      : in FIELD := DEFAULT_EXP);
  533.     pragma IO_interface(PUT,PUT_FLOAT_ITEM,NUM);
  534.     
  535.     procedure GET (FROM : in STRING; ITEM: out NUM; LAST: out POSITIVE);
  536.     pragma IO_interface(GET,GET_FLOAT_STRING,NUM);
  537.     procedure PUT (TO   : out STRING;
  538.                    ITEM : in NUM;
  539.                    AFT  : in FIELD := DEFAULT_AFT;
  540.                    EXP  : in FIELD := DEFAULT_EXP);
  541.     pragma IO_interface(PUT,PUT_FLOAT_STRING,NUM);
  542.  
  543.   end FLOAT_IO;
  544.  
  545.  
  546.   generic
  547.     type NUM is delta <>;
  548.   package FIXED_IO is
  549.  
  550.     DEFAULT_FORE : FIELD := NUM'FORE;
  551.     DEFAULT_AFT  : FIELD := NUM'AFT;
  552.     DEFAULT_EXP  : FIELD := 0;
  553.  
  554.     procedure GET (FILE : in FILE_TYPE; ITEM : out NUM;
  555.                                         WIDTH : in FIELD := 0);
  556.     pragma IO_interface(GET,GET_FIXED_FILE_ITEM,NUM);
  557.     procedure GET (ITEM : out NUM; WIDTH : in FIELD := 0);
  558.     pragma IO_interface(GET,GET_FIXED_ITEM,NUM);
  559.  
  560.     procedure PUT (FILE        : in FILE_TYPE;
  561.            ITEM        : in NUM;
  562.            FORE     : in FIELD := DEFAULT_FORE;
  563.            AFT      : in FIELD := DEFAULT_AFT;
  564.                    EXP          : in FIELD := DEFAULT_EXP);
  565.     pragma IO_interface(PUT,PUT_FIXED_FILE_ITEM,NUM);
  566.  
  567.     procedure PUT (ITEM        : in NUM;
  568.            FORE     : in FIELD := DEFAULT_FORE;
  569.            AFT      : in FIELD := DEFAULT_AFT;
  570.                    EXP          : in FIELD := DEFAULT_EXP);
  571.     pragma IO_interface(PUT,PUT_FIXED_ITEM,NUM);
  572.  
  573.     procedure GET (FROM : in STRING; ITEM: out NUM; LAST: out POSITIVE);
  574.     pragma IO_interface(GET,GET_FIXED_STRING,NUM);
  575.     procedure PUT (TO   : out STRING;
  576.                    ITEM : in  NUM;
  577.                    AFT  : in  FIELD := DEFAULT_AFT;
  578.                    EXP  : in  FIELD := DEFAULT_EXP);
  579.     pragma IO_interface(PUT,PUT_FIXED_STRING,NUM);
  580.  
  581.   end FIXED_IO;
  582.  
  583.       
  584.   -- Generic package for Input-Output of Enumeration Types
  585.  
  586.   generic
  587.     type ENUM is (<>);
  588.   package ENUMERATION_IO is
  589.  
  590.     DEFAULT_WIDTH   : FIELD := 0;
  591.     DEFAULT_SETTING : TYPE_SET := UPPER_CASE;
  592.  
  593.     procedure GET (FILE : in FILE_TYPE; ITEM : out ENUM);
  594.     pragma IO_interface(GET,GET_ENUM_FILE_ITEM,ENUM);
  595.     procedure GET (ITEM : out ENUM);
  596.     pragma IO_interface(GET,GET_ENUM_ITEM,ENUM);
  597.  
  598.     procedure PUT (FILE       :    in FILE_TYPE;
  599.            ITEM       :    in ENUM;
  600.            WIDTH      :    in FIELD    := DEFAULT_WIDTH;
  601.            SET        : in TYPE_SET := DEFAULT_SETTING);
  602.     pragma IO_interface(PUT,PUT_ENUM_FILE_ITEM,ENUM);
  603.  
  604.     procedure PUT (ITEM       :    in ENUM;
  605.            WIDTH      :    in FIELD    := DEFAULT_WIDTH;
  606.            SET        :    in TYPE_SET := DEFAULT_SETTING);
  607.     pragma IO_interface(PUT,PUT_ENUM_ITEM,ENUM);
  608.  
  609.     procedure GET(FROM : in STRING; ITEM: out ENUM; LAST: out POSITIVE);
  610.     pragma IO_interface(GET,GET_ENUM_STRING,ENUM);
  611.     procedure PUT (TO   : out STRING;
  612.                    ITEM : in  ENUM;
  613.                    SET  : in  TYPE_SET := DEFAULT_SETTING);
  614.     pragma IO_interface(PUT,PUT_ENUM_STRING,ENUM);
  615.  
  616.   end ENUMERATION_IO;
  617.  
  618.  
  619.   -- Exceptions:
  620.   --  
  621.   -- These are the exceptions whose names are visible to the   
  622.   -- calling environment.   
  623.      
  624.   STATUS_ERROR    : exception renames IO_EXCEPTIONS.STATUS_ERROR;
  625.   MODE_ERROR    : exception renames IO_EXCEPTIONS.MODE_ERROR;
  626.   NAME_ERROR    : exception renames IO_EXCEPTIONS.NAME_ERROR;
  627.   USE_ERROR    : exception renames IO_EXCEPTIONS.USE_ERROR;
  628.   DEVICE_ERROR    : exception renames IO_EXCEPTIONS.DEVICE_ERROR;
  629.   END_ERROR    : exception renames IO_EXCEPTIONS.END_ERROR;
  630.   DATA_ERROR    : exception renames IO_EXCEPTIONS.DATA_ERROR;
  631.   LAYOUT_ERROR    : exception renames IO_EXCEPTIONS.LAYOUT_ERROR;
  632.  
  633.  
  634.     
  635. private
  636.  
  637.     UNINITIALIZED: constant := 0;
  638.     type FILE_TYPE is record
  639.                          FILENUM: INTEGER := UNINITIALIZED; 
  640.                       end record;
  641.  
  642. end TEXT_IO; 
  643.  
  644. package body TEXT_IO is
  645.  
  646.    package body INTEGER_IO is
  647.    end INTEGER_IO;
  648.  
  649.    package body FLOAT_IO is
  650.    end FLOAT_IO;
  651.  
  652.    package body FIXED_IO is
  653.    end FIXED_IO;
  654.  
  655.    package body ENUMERATION_IO is
  656.    end ENUMERATION_IO;
  657.  
  658. end TEXT_IO;
  659.  
  660. pragma page;
  661. -- Predefined library units:  calendar & generic subprograms
  662.  
  663. package CALENDAR is
  664.    type TIME is private;
  665.  
  666.    subtype YEAR_NUMBER  is INTEGER  range 1901 .. 2099;
  667.    subtype MONTH_NUMBER is INTEGER  range 1 .. 12;
  668.    subtype DAY_NUMBER   is INTEGER  range 1 .. 31;
  669.    subtype DAY_DURATION is DURATION range 0.0 .. 86_400.0;
  670.  
  671.    function CLOCK return TIME;
  672.    pragma IO_interface(CLOCK,CLOCK);
  673.  
  674.    function YEAR   (DATE    : TIME) return YEAR_NUMBER;
  675.    pragma IO_interface(YEAR,YEAR);
  676.    function MONTH  (DATE    : TIME) return MONTH_NUMBER;
  677.    pragma IO_interface(MONTH,MONTH);
  678.    function DAY    (DATE    : TIME) return DAY_NUMBER;
  679.    pragma IO_interface(DAY,DAY);
  680.    function SECONDS(DATE    : TIME) return DAY_DURATION;
  681.    pragma IO_interface(SECONDS,SECONDS);
  682.  
  683.    procedure SPLIT (DATE    : in  TIME;
  684.                     YEAR    : out YEAR_NUMBER;
  685.                     MONTH   : out MONTH_NUMBER;
  686.                     DAY     : out DAY_NUMBER;
  687.                     SECONDS : out DAY_DURATION);
  688.    pragma IO_interface(SPLIT,SPLIT);
  689.  
  690.    function TIME_OF(YEAR    : YEAR_NUMBER;
  691.                     MONTH   : MONTH_NUMBER;
  692.                     DAY     : DAY_NUMBER;
  693.                     SECONDS : DAY_DURATION := 0.0) return TIME;
  694.    pragma IO_interface(TIME_OF,TIME_OF);
  695.  
  696.    function "+"  (LEFT : TIME;     RIGHT : DURATION) return TIME;
  697.    pragma IO_interface("+",ADD_TIME_DUR);
  698.    function "+"  (LEFT : DURATION; RIGHT : TIME)     return TIME;
  699.    pragma IO_interface("+",ADD_DUR_TIME);
  700.    function "-"  (LEFT : TIME;     RIGHT : DURATION) return TIME;
  701.    pragma IO_interface("-",SUB_TIME_DUR);
  702.    function "-"  (LEFT : TIME;     RIGHT : TIME)     return DURATION;
  703.    pragma IO_interface("-",SUB_TIME_TIME,DURATION);
  704.  
  705.    function "<"  (LEFT, RIGHT : TIME) return BOOLEAN;
  706.    pragma IO_interface("<",LT_TIME);
  707.    function "<=" (LEFT, RIGHT : TIME) return BOOLEAN;
  708.    pragma IO_interface("<=",LE_TIME);
  709.    function ">"  (LEFT, RIGHT : TIME) return BOOLEAN;
  710.    pragma IO_interface(">",GT_TIME);
  711.    function ">=" (LEFT, RIGHT : TIME) return BOOLEAN;
  712.    pragma IO_interface(">=",GE_TIME);
  713.  
  714.    TIME_ERROR : exception;   --   can be raised by TIME_OF, "+", "-"
  715.  
  716. private 
  717.  
  718.    type TIME is record
  719.                    Y_N : YEAR_NUMBER;
  720.                    M_N : MONTH_NUMBER;
  721.                    D_N : DAY_NUMBER;
  722.                    D_D : DURATION;
  723.                 end record;
  724.  
  725. end CALENDAR;
  726.  
  727. package body CALENDAR is
  728. end CALENDAR;
  729.  
  730. pragma page;
  731. generic
  732.    type OBJECT is limited private;
  733.    type NAME   is access OBJECT;
  734. procedure UNCHECKED_DEALLOCATION(X : in out NAME);
  735. procedure UNCHECKED_DEALLOCATION(X : in out NAME) is
  736. begin
  737.    X := null;
  738. end;
  739.  
  740. generic
  741.    type SOURCE is limited private;
  742.    type TARGET is limited private;
  743. function UNCHECKED_CONVERSION(S : SOURCE) return TARGET;
  744. function UNCHECKED_CONVERSION(S : SOURCE) return TARGET is
  745. NOT_USED_ANYWAY: TARGET;
  746. begin
  747.    raise PROGRAM_ERROR;
  748.    return NOT_USED_ANYWAY;
  749. end;
  750.